Gender Equity in Louisville

load("clean_svybydemog_data.RData")

Gender equity in Louisville is an unfortunately unequal reality. Women are worse off in key standard of living areas such as household income and home-ownership. Additionally, these issues are exasperated for women from a one-income home, women with children and minority women. Disproportionate cost of living burdens and care-taking responsibilities can perpetuate a viscous cycle of inequity. Understanding the true size of the ‘equity gap’ can help inform policy decisions to stop this cycle from continuing.

Key Takeaways:

1. Women in Louisville, especially women from a one-income household make significantly less money than men from a one-income household.
2. For women in Louisville from a one-income household, as the number of children in the household increases the fewer women earn a living wage.
3. An overwhelming majority of women from a one-income home .
4. Women in Louisville from a one-income household who pay at least 30% of their income in home expenses (rent or mortgage, utilities) rarely earn more than $70,000.
5. Compared to peer cities, Louisville has relatively high home ownership for women from a one-income household with no children. However, for women from a one-income household with children, we are second to last. Additionally, homeownership for women from a one-income household with children has been steadily decreasing since 2016.
6. Homeownership issues for women from a one-income household are increased for minority women, with black women having the lowest ownership rates.

Waffle Chart

Income

Income Percentiles

#fix formatting
single_earner_pctiles <- lville_2019 %>%
  group_by(sex) %>%
  summarize(
    ten_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.1),
    twenty_five_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.25),
    fifty_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.5),
    seventy_five_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.75),
    ninety_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.9))

library(gt) 

gt(single_earner_pctiles) %>%
  tab_header(title = "Income Percentiles by Sex",
             subtitle = "") %>%
  fmt_currency(columns = vars(ten_pct, twenty_five_pct, fifty_pct, seventy_five_pct,
                              ninety_pct),
                            use_subunits = F) %>%
  cols_label(ten_pct = "10th",
             twenty_five_pct = "25th",
             fifty_pct = "Median",
             seventy_five_pct   = "75th",
             ninety_pct = "90th") %>%
  cols_align(align = "center") %>%
      tab_source_note(
    source_note = md("Source: ACS microdata from IPUMS-USA")) %>%
  opt_row_striping(row_striping = TRUE) %>%
  opt_table_outline() %>%
  tab_options(
    table.font.size = px(12),
    table.width = pct(50)) %>%
  tab_style(
    cell_text(
      font = "Montserrat",
      weight = "bold"), 
    cells_row_groups())

Income Percentiles by Sex
sex	10th	25th	Median	75th	90th
female	$11,200	$25,000	$50,000	$91,000	$152,000
male	$18,000	$37,000	$66,900	$108,400	$170,000
Source: ACS microdata from IPUMS-USA

Income by Earner Gender

Counts

p <- lville_2019 %>% 
  filter(HHINCOME <= cut_95,
         earner_type == "single_earner") %>%
  func_plt_hist_overlay( "sex")

p <- p + glp_graph_theme

p <- p + labs(
  title = "Single Earner Income by Gender",
) +
  
  ylab(" ") +
  
  guides(color = FALSE) + 
  
  facet_wrap(~sex, nrow = 2) +
  
  theme(
  #axis.ticks.x =  element_line(size = 50000),
  strip.text = element_blank()

  )  +

scale_x_continuous(
  breaks = c(50000, 100000, 150000, 200000),
  label = c("$50k", "$100k", "$150k", "$200k")
) +
  scale_y_continuous(labels = scales::comma)

p

Percent

temp_df <- lville_2019 %>% 
  filter(HHINCOME <= cut_95,
         earner_type == "single_earner")

  p_percent <- ggplot(temp_df, aes(x=HHINCOME, 
                                   y = (..count..)/sum(..count..),
                                   fill=sex, 
                                   color = sex, 
                                   weight = HHWT)) +
    geom_histogram(alpha=0.5, position = 'identity', binwidth = 10000) +
    scale_fill_manual(values = c("#0E4A99", "#F58021", "#00A9B7")) +
    scale_color_manual(values = c("#0E4A99", "#F58021", "#00A9B7")) +

    labs(fill="") +
    xlab("Household Income") +
    ylab("Percentage") 

p_percent <- p_percent + glp_graph_theme

p_percent <- p_percent + labs(
  title = "Single Earner Income by Gender",
) +
  
  ylab(" ") +
  
  guides(color = FALSE) + 
  
  facet_wrap(~sex, nrow = 2) +
  
  theme(
  #axis.ticks.x =  element_line(size = 50000),
  strip.text = element_blank()

  )  +

scale_x_continuous(
  breaks = c(50000, 100000, 150000, 200000),
  label = c("$50k", "$100k", "$150k", "$200k")
) +
  scale_y_continuous(labels=percent)

p_percent

Single Female Income by Race

All Single Female Earners

##add original faceted graph
sing_fem_inc_race<-census_microdata081122 %>% 
  filter(
    FIPS == "21111",
    year %in% 2016:2019,
    sex == 'female',
    earner_type == 'single_earner',
    HHINCOME <= cut_95) 
  
   sing_fem_inc_race_plt <- sing_fem_inc_race %>%
   ggplot( aes(x=HHINCOME, 
              y = (..count..)/sum(..count..),
               fill=race, 
               color = race, 
               weight = HHWT)) +
    geom_histogram(alpha=0.5, position = 'identity', binwidth = 10000) 


sing_fem_inc_race_plt <- sing_fem_inc_race_plt + facet_wrap(~race, nrow = 2) 

sing_fem_inc_race_plt <- sing_fem_inc_race_plt + glp_graph_theme

sing_fem_inc_race_plt <- sing_fem_inc_race_plt + 
  labs(
  title = "Female Single Earner Income",
) + 
  ylab(" ") +
  xlab("Household Income")
  
  # guides(color = FALSE)

sing_fem_inc_race_plt <- sing_fem_inc_race_plt + 
  
  theme( 
  #axis.ticks.x =  element_line(size = 50000),
  strip.text = element_blank()
  
  )  + 

scale_x_continuous(
  breaks = c(50000, 100000, 150000),
  label = c("$50k", "$100k", "$150k")
) +
  scale_y_continuous(labels = scales::percent)

sing_fem_inc_race_plt <- sing_fem_inc_race_plt +
  
  scale_fill_manual(values = c("#0E4A99", "#F58021","#00A9B7", "#800055")) +
  scale_color_manual(values = c("#0E4A99","#F58021","#00A9B7", "#800055")) 

sing_fem_inc_race_plt

Single Black Female Earners

black_female_earner <- func_income_by_race("black")
black_female_earner

### Single Hispanic Female Earners

hisp_female_earner <- func_income_by_race("hispanic")
hisp_female_earner <- hisp_female_earner + 
  labs(
  title = "Hispanic Female Single Earner Income",
) + 
  scale_fill_manual(values = "#0E4A99") +
  scale_color_manual(values = "#0E4A99")
  
hisp_female_earner

Single White Female Earners

white_female_earner <- func_income_by_race("white")
white_female_earner <- white_female_earner + 
  labs(
  title = "White Female Single Earner Income",
)  + 
  scale_fill_manual(values = "#F58021") +
  scale_color_manual(values = "#F58021")

white_female_earner

Single Other Race Female Earners

other_female_earner <- func_income_by_race("other")
other_female_earner <- other_female_earner + 
  labs(
  title = "Other Female Single Earner Income",
) + 
  scale_fill_manual(values = "#00A9B7") +
  scale_color_manual(values = "#00A9B7")

other_female_earner

Female Single Income Compared to Living Wage

func_income_by_kids <- function(num_kids, living_wage) {



  w <- census_microdata081122 %>% 
  filter(
    FIPS == "21111",
    year %in% 2016:2019,
    sex == 'female',
    NCHILD == num_kids,
    earner_type == 'single_earner',
    HHINCOME <= cut_95) 
  
   w <- w %>%
   ggplot( aes(x=HHINCOME, 
              y = (..count..)/sum(..count..),
              fill = sex,
              group = sex,
               weight = HHWT)) +
    geom_histogram(alpha=0.5, position = 'identity', binwidth = 10000) +
     geom_vline( aes(xintercept = living_wage), linetype = "dashed",  colour="blue", size = 1.5) 
   

#sing_fem_inc_race_plt <- sing_fem_inc_race_plt + facet_wrap(~race, nrow = 2) 

w <- w + glp_graph_theme

w <- w + 
  labs(
  title = "Black Female Single Earner Income",
) + 
  ylab(" ") +
  xlab("Household Income")+
  
  guides(color = FALSE)

w <- w + 
  
  theme( 
  #axis.ticks.x =  element_line(size = 50000),
  strip.text = element_blank()
  
  )  + 
  
scale_x_continuous(
  breaks = c(50000, 100000, 150000),
  label = c("$50k", "$100k", "$150k")
) +
  scale_y_continuous(labels = scales::percent) 
    
  
  return (w)

}

Single Female Earner No Child

#why is color not working?
#still need to add living wage lines

under_liv_wage_0 <- census_microdata081122 %>% 
  filter(
    FIPS == "21111",
    year %in% 2016:2019,
    sex == 'female',
    NCHILD == 0,
    earner_type == 'single_earner') %>%
  group_by(HHINCOME < 30303.98) %>%
  summarize(count = sum(HHWT)) #a little more than half are earning a living wage
#do this for each graphof this type...add info above chunk

no_kids_female_earner <- func_income_by_kids(0, 30303.98)
no_kids_female_earner <- no_kids_female_earner + 
  labs(
  title = "Female Single Earner Income, No Children",
) + 
  scale_fill_discrete(labels = "No Children")

no_kids_female_earner

Single Female Earner With One Child

under_liv_wage_1 <- census_microdata081122 %>% 
  filter(
    FIPS == "21111",
    year %in% 2016:2019,
    sex == 'female',
    NCHILD == 1,
    earner_type == 'single_earner') %>%
  group_by(HHINCOME < 60264.75) %>%
  summarize(count = sum(HHWT))

one_child <- func_income_by_kids(1, 60264.75)
one_child <- one_child + 
  labs(
  title = "Female Single Earner Income, One Child",
) + 
  scale_fill_manual(values = "#800055", labels = "One Child" ) +
  scale_color_manual(values = "#800055") 

one_child

Single Female Earner with Two Children

under_liv_wage_2 <- census_microdata081122 %>% 
  filter(
    FIPS == "21111",
    year %in% 2016:2019,
    sex == 'female',
    NCHILD == 2,
    earner_type == 'single_earner') %>%
  group_by(HHINCOME < 76451.81) %>%
  summarize(count = sum(HHWT))

two_child <- func_income_by_kids(2, 76451.81)
two_child <- two_child + 
  labs(
  title = "Female Single Earner Income, Two Children",
) + 
  scale_fill_manual(values = "#356E39", labels = "Two Children") +
  scale_color_manual(values = "#356E39") 

two_child

Single Female Earner with Three Children

under_liv_wage_3 <- census_microdata081122 %>% 
  filter(
    FIPS == "21111",
    year %in% 2016:2019,
    sex == 'female',
    NCHILD == 3,
    earner_type == 'single_earner') %>%
  group_by(HHINCOME < 101452.61) %>%
  summarize(count = sum(HHWT))

three_child <- func_income_by_kids(3, 101452.61)
three_child <- three_child + 
  labs(
  title = "Female Single Earner Income With Three Children",
) + 
  scale_fill_manual(values = "#CFB94C", labels = "Three Children") +
  scale_color_manual(values = "#CFB94C") 

three_child

Single Female Earners Cost Burden

these_labels <- paste0(dollar(seq(1, 273500, 10000), scale = 0.001, accuracy = 1, suffix = "k"))

cost_burden_sf <- lville_2019 %>% 
  filter(
    sex == 'female',
    earner_type == 'single_earner',
    HHINCOME <= cut_95) %>%
  mutate(
    cost_burden = factor(cost_burden, 
                         levels = rev(c(TRUE, FALSE)), 
                         labels = rev(c("Cost Burdened", "Non Cost Burdened")), 
                         ordered = TRUE),
    inc_bins = cut(HHINCOME, seq(1, 283500, 10000),
                   labels = these_labels) %>%
      factor(levels = these_labels, ordered = TRUE)
    )
    
temp_df <- cost_burden_sf %>%
  group_by(inc_bins, cost_burden) %>%
  summarize(count = sum(HHWT), .groups = "drop") %>%
  complete(inc_bins, cost_burden, fill = list(count = 0)) %>%
  filter(!is.na(inc_bins)) %>%
  group_by(inc_bins) %>%
  mutate(percent = count / sum(count)) %>%
  ungroup() %>%
  filter(cost_burden == "Cost Burdened")
 
temp_df <- temp_df[1:14,]

cost_burden_sf_plot <- ggplot(temp_df, 
       aes(x = inc_bins,
           y = percent,
           group = 1)) +
  geom_line(linetype = "dotted", color="purple", size=3) +
  geom_point(color="purple", size=8)

cost_burden_sf_plot <- cost_burden_sf_plot + glp_graph_theme

cost_burden_sf_plot <- cost_burden_sf_plot + 
  labs(
  title = "Female Single Earner Cost Burden Level by Income",
) + 
  ylab(" ") +
  xlab("Household Income") +
  
  guides(color = FALSE) +
  
  theme(
  strip.text = element_blank()

  )  +

  scale_color_manual(values = c("#0E4A99")) +
  scale_y_continuous(labels = scales::percent)

cost_burden_sf_plot

#I_CB_earn_trend <- survey_by_demog(census_microdata081122, weight_var = "HHWT", 'cost_burden', other_grouping_vars = c('earner_type'), breakdowns = "sex")

# I_CB_earn_trend <- survey_by_demog(census_microdata081122, weight_var = "HHWT", 'cost_burden', other_grouping_vars = c('earner_type_d'))

I_CB_earn_trend %<>%
  filter(
    var_type == 'percent',
    race == 'total',
    sex == 'total') %>%
  select( -c(sex,race)) %>%
  pivot_wider(names_from = "earner_type_d", values_from = "cost_burden")
  

trend(I_CB_earn_trend, 
      multiple_earner:single_fem_earner:single_male_earner, 
      pctiles = F,
      plot_title = "Cost Burden by Earner Type",
      cat = c("Multiple Earners" = "multiple_earner", "Single Female Earner" = "single_fem_earner", "Single Male Earner" = "single_male_earner"),
      y_title = 'Percent',
      caption_text = 
      "Source Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

I_median_earn_age <- lville_2019 %>%
  group_by(age_group, earner_type_d) %>%
  summarize(Med=median(HHINCOME)) 

I_median_earn_age_plot <- ggplot(I_median_earn_age, 
       aes(x=age_group, y=Med, fill = earner_type_d)) + 
  geom_bar(stat="identity", position='dodge') 

I_median_earn_age_plot <- I_median_earn_age_plot + glp_graph_theme

I_median_earn_age_plot <- I_median_earn_age_plot +
  labs(
  title = "Median Earnings by Age Group",
) + 
  ylab("Household Income") +
  xlab("Age Group") +
  
  scale_y_continuous(labels = scales::dollar) +   
  scale_fill_manual(
    values = c("#0E4A99", "#F58021", "#00A9B7"), 
    labels = c("Multiple Earner", "Single Female Earner", "Single Male Earner"))

  
I_median_earn_age_plot

Homeownership

Trends in Homeownership by gender

temp_df <- H_earntype %>%
  filter(race == 'total',
         var_type == "percent", sex == "total") %>%
  pivot_wider(names_from = "earner_type_d", values_from = "homeownership")

trend(temp_df, 
      multiple_earner:single_male_earner,
      plot_title = "Homeownership by Year", 
      cat = c("Multiple Earners" = "multiple_earner", "Single Female" = "single_fem_earner", "Single Male" = "single_male_earner"),
      pctiles = F,
      y_title = 'Percent',
      rollmean = 3,
      caption_text = 
      "Source: Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

Single female homeownership

Ranking

temp_df <- H_earntype %>% 
  filter(earner_type_d == "single_fem_earner",
         var_type == "percent", sex == "total") %>%
  mutate(sex = "total")

ranking(temp_df, 
        'homeownership',
        plot_title = "Single Earner Female Homeownership",
        caption_text = 
      "Source: Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

Presence of Children

H_s_Femkids_trend %<>%
  filter(
    var_type == 'percent',
    race == 'total',
    sex == "female") %>%
  pivot_wider(names_from = 'kd_pres', values_from = 'homeownership') %>%
  select(-sex)


trend(H_s_Femkids_trend, 
      kids:no_kids,
      rollmean = 3,
      plot_title = "Female Homeownership by Presence of Children", 
      cat = c("Children" = "kids", "No Children" = "no_kids"), 
      y_title = 'Percent',
      caption_text = 
      "Source: Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

Ranking with Children

ranking(H_sinFem_kids,
        'homeownership',
        plot_title = "Single Earner Female Homeownership with Children",
        #title_scale = 0.8,
        caption_text = 
      "Source: Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

temp_df <- H_earntype %>%
  filter(earner_type_d == "single_fem_earner",
         var_type == "percent", sex == "total")

trend(filter(temp_df, race != "hispanic"), 
      homeownership, 
      rollmean = 3,
      pctiles = F,
      plot_title = "Single Female Homeownership by Year", 
      cat = 'race', 
      y_title = 'Percent',
      caption_text = 
      "Source Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

Homeownership by Race by Children

With Children

df_kids_race <- census_microdata081122 %>%
  group_by(FIPS, year, race, earner_type_d, kd_pres) %>%
  summarize(homeownership = sum(HHWT[homeownership]) / sum(HHWT) * 100, .groups = "drop")

df_kids <- census_microdata081122 %>%
  group_by(FIPS, year, earner_type_d, kd_pres) %>%
  summarize(homeownership = sum(HHWT[homeownership]) / sum(HHWT) * 100, .groups = "drop") %>%
  mutate(race = "total")

df_kids %<>%
  bind_rows(df_kids_race) %>%
  select(FIPS, year, race, earner_type_d, homeownership, kd_pres) %>%
  filter(earner_type_d == "single_fem_earner",
         kd_pres == "kids")

trend(filter(df_kids, race != "hispanic"), 
      homeownership, 
      rollmean = 3,
      pctiles = F,
      plot_title = "Single Female Homeownership by Year with Children", 
      cat = 'race', 
      y_title = 'Percent',
      caption_text = 
      "Source Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

Without Children

df_no_kids_race <- census_microdata081122 %>%
  group_by(FIPS, year, race, earner_type_d, kd_pres) %>%
  summarize(homeownership = sum(HHWT[homeownership]) / sum(HHWT) * 100, .groups = "drop")

df_no_kids <- census_microdata081122 %>%
  group_by(FIPS, year, earner_type_d, kd_pres) %>%
  summarize(homeownership = sum(HHWT[homeownership]) / sum(HHWT) * 100, .groups = "drop") %>%
  mutate(race = "total")

df_no_kids %<>%
  bind_rows(df_no_kids_race) %>%
  select(FIPS, year, race, earner_type_d, homeownership, kd_pres) %>%
  filter(earner_type_d == "single_fem_earner",
         kd_pres == "no_kids")

trend(filter(df_no_kids, race != "hispanic"), 
      homeownership, 
      rollmean = 3,
      pctiles = F,
      plot_title = "Single Female Homeownership by Year without Children", 
      cat = 'race', 
      y_title = 'Percent',
      caption_text = 
      "Source Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

Affordable Housing need for Female Single Earners

need to add text here

Education

E_singM_singF <- census_microdata081122 %>% 
  filter(year %in% 2017:2019, 
         earner_type == 'single_earner') %>%
  group_by(sex, educ, kd_pres) %>%
  summarize(n=sum(HHWT, na.rm = TRUE)) %>%
  mutate(
    total = sum(n),
    rate = n/sum(n)*100,
    educ = factor(educ, 
                  levels = rev(c("no_hs", "hs", "some_col", "assoc", "bach","grad")), 
                  ordered = TRUE))


E_singM_singF_plot <- ggplot(E_singM_singF, 
       aes(x=sex, 
           y=rate, 
           fill = educ)) + 
  geom_bar(stat="identity", position = "fill") 


E_singM_singF_plot <- E_singM_singF_plot + facet_wrap(~kd_pres) 
  
E_singM_singF_plot <- E_singM_singF_plot + glp_graph_theme

E_singM_singF_plot <- E_singM_singF_plot + 
  
  theme(
    legend.position = "right"
    ) +

  labs(
  title = "Single Earner Education Levels by Gender",
) + 
  ylab(" ") +
  xlab(" ") +
  scale_fill_discrete(
    labels = c("Graduate","Bachelor", "Associate", "Some College",  "High School", "No High School")) + 
  scale_x_discrete (labels = c("female" = "Female", "male" = "Male")) +
  
  scale_y_continuous(labels = scales::percent)

E_singM_singF_plot

E_singF_race <- lville_2019 %>% 
  filter(
    sex == 'female',
    earner_type == 'single_earner') %>%
  group_by(race, educ) %>%
  summarize(n=sum(HHWT, na.rm = TRUE)) %>%
  mutate(
    total = sum(n),
    rate = n/sum(n)*100,
    educ = factor(educ, 
                  levels = rev(c("no_hs", "hs", "some_col", "assoc", "bach","grad")), 
                  ordered = TRUE))

E_singF_race_plot <- ggplot(E_singF_race, aes(x=race, y=rate, fill=educ)) + 
geom_bar(stat="identity", position='fill')


E_singF_race_plot <- E_singF_race_plot + glp_graph_theme

E_singF_race_plot <- E_singF_race_plot + 
    theme(
    legend.position = "right"
    ) +
  labs(
  title = "Single Female Education Breakdown",
) + 
  ylab(" ") +
  xlab("Race") +
  scale_fill_discrete(labels = c("Graduate","Bachelor", "Associate", "Some College",  "High School", "No High School")) + 
  scale_x_discrete (labels = c("female" = "Female", "male" = "Male")) +
  
  scale_y_continuous(labels = scales::percent)

E_singF_race_plot

Household Age

cost_burden_age_sf %<>% drop_na(cost_burden) #this will need to be run once and then left alone if tweaking graphs

cost_burden_age_sf_plot <- ggplot(cost_burden_age_sf,
       aes(x=age_group, y=HHWT , fill=cost_burden),
        color="#00A9B7") +
geom_bar(stat="identity", position='fill')

cost_burden_age_sf_plot <- cost_burden_age_sf_plot + glp_graph_theme

cost_burden_age_sf_plot <- cost_burden_age_sf_plot + 
    theme(
    legend.position = "right"
    ) +
  labs(
  title = "Cost Burdened Status by Age",
) + 
  ylab(" ") +
  xlab("Race") +
  scale_fill_discrete(labels = c("Non Cost Burdened", "Cost Burdened")) + 
  #scale_x_discrete (labels = c("female" = "Female", "male" = "Male")) +
  
  scale_y_continuous(labels = scales::percent)

cost_burden_age_sf_plot

Cost Burdened Status by Age and Earner Type

Female Single Earner

temp_df1 <- cost_burden_age_sf %>%
  filter(earner_type_d == "single_fem_earner") %>%
  mutate(
    age_group = case_when(
      age %in% 15:19 ~ NA_character_, 
      age %in% 20:29 ~ "20-29", 
      age %in% 30:39 ~ "30-39",  
      age %in% 40:49 ~ "40-49",  
      age %in% 50:59 ~ "50-59",  
      age %in% 60:69 ~ "60-69", 
      age %in% 70:79 ~ "70-79", 
      age >= 80 ~ "80+"))

temp_df1 %<>%  filter(!is.na(age_group))

cost_burden_age_sf_facet_plt <- ggplot(temp_df1,
       aes(x=age_group, y=HHWT , fill=cost_burden),
        color="#00A9B7") +
geom_bar(stat="identity", position='fill')
  
#facet_wrap(~earner_type_d)

cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt + glp_graph_theme

cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt + 
    theme(
    legend.position = "right",
    
    strip.text = element_text(size = 40)
    ) +
  labs(
  title = "Cost Burdened Status by Age and Earner Type",
) + 
  ylab(" ") +
  xlab(" ") +
  scale_fill_discrete(labels = c("Non Cost Burdened", "Cost Burdened")) + 
  scale_x_discrete(guide = guide_axis(n.dodge=2)) +

  scale_y_continuous(labels = scales::percent)

cost_burden_age_sf_facet_plt

### Male Single Earner

temp_df2 <- cost_burden_age_sf %>%
  filter(earner_type_d == "single_male_earner") %>%
  mutate(
    age_group = case_when(
      age %in% 15:19 ~ NA_character_, 
      age %in% 20:29 ~ "20-29", 
      age %in% 30:39 ~ "30-39",  
      age %in% 40:49 ~ "40-49",  
      age %in% 50:59 ~ "50-59",  
      age %in% 60:69 ~ "60-69", 
      age %in% 70:79 ~ "70-79", 
      age >= 80 ~ "80+"))

temp_df2 %<>%  filter(!is.na(age_group))

cost_burden_age_sf_facet_plt <- ggplot(temp_df2,
       aes(x=age_group, y=HHWT , fill=cost_burden),
        color="#00A9B7") +
geom_bar(stat="identity", position='fill')
  
#facet_wrap(~earner_type_d)

cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt + glp_graph_theme

cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt + 
    theme(
    legend.position = "right",
    
    strip.text = element_text(size = 40)
    ) +
  labs(
  title = "Cost Burdened Status by Age and Earner Type",
) + 
  ylab(" ") +
  xlab(" ") +
  scale_fill_discrete(labels = c("Non Cost Burdened", "Cost Burdened")) + 
  scale_x_discrete(guide = guide_axis(n.dodge=2)) +

  scale_y_continuous(labels = scales::percent)

cost_burden_age_sf_facet_plt

Multiple Earner

temp_df3 <- cost_burden_age_sf %>%
  filter(earner_type_d == "multiple_earner") %>%
  mutate(
    age_group = case_when(
      age %in% 15:19 ~ NA_character_, 
      age %in% 20:29 ~ "20-29", 
      age %in% 30:39 ~ "30-39",  
      age %in% 40:49 ~ "40-49",  
      age %in% 50:59 ~ "50-59",  
      age %in% 60:69 ~ "60-69", 
      age %in% 70:79 ~ "70-79", 
      age >= 80 ~ "80"))
  
temp_df3 %<>% filter(!is.na(age_group))

cost_burden_age_sf_facet_plt <- ggplot(temp_df3,
       aes(x=age_group, y=HHWT , fill=cost_burden),
        color="#00A9B7") +
geom_bar(stat="identity", position='fill')
  
#facet_wrap(~earner_type_d)

cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt + glp_graph_theme

cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt + 
    theme(
    legend.position = "right",
    
    strip.text = element_text(size = 40)
    ) +
  labs(
  title = "Cost Burdened Status by Age and Earner Type",
) + 
  ylab(" ") +
  xlab(" ") +
  scale_fill_discrete(labels = c("Non Cost Burdened", "Cost Burdened")) + 
  scale_x_discrete(guide = guide_axis(n.dodge=2)) +

  scale_y_continuous(labels = scales::percent)

cost_burden_age_sf_facet_plt

Earner Types Over Time

earner_trend <- census_microdata081122 %>%
  
  mutate(
    earner_type_d = case_when(
      sex == 'female' & earner_type == 'single_earner' ~ 'single_fem_earner',
      sex == 'male' & earner_type == 'single_earner' ~ 'single_male_earner',
      earner_type == 'multi_earner' ~ 'multiple_earner')
  ) %>% 
  group_by(year, earner_type_d) %>%
  summarize(n=sum(HHWT, na.rm = TRUE)) %>%
  mutate(
    total = sum(n),
    rate = n/sum(n)*100) 
  
earner_trend_plt <- ggplot(earner_trend, 
       aes(x=year, y=rate, fill=earner_type_d),
        color="#00A9B7") + 
geom_bar(stat="identity", position='fill')


earner_trend_plt <- earner_trend_plt + glp_graph_theme

earner_trend_plt <- earner_trend_plt + 
    theme(
    legend.position = "right"
    #strip.text = element_blank()
    ) +
  labs(
  title = "Earner Type Trend"
) + 
  ylab(" ") +
  xlab(" ") +
  scale_fill_discrete(labels = c("Multiple Earner", "Single Female Earner", "Single Male Earner")) + 

  scale_y_continuous(labels = scales::percent)

earner_trend_plt